package require Tk
if [catch {package require tooltip}] {
    set USETOOLTIP 0
} else {
    set USETOOLTIP 1
}

proc getChildren { array parent } {
    upvar $array Array
    global Child
    set list {}
    set child {}
    if [info exists Child($parent) ] {
	set child $Child($parent)
    }
    foreach name [array names Array $parent.* ] {
	set name [split [string map [list $parent. "" ] $name ] .]
	if {[llength $name ] == 1 && [string first $name $child] < 0 } { 
	    lappend list $name
	}
    }
    return [concat $child $list]
}

proc packForm {form parent} { 
    global Title Description Container USETOOLTIP
    ttk::frame $parent.$form -height 300 -width 400
    #	puts "add $title($form)"
    $parent add $parent.$form -text $Title($form)
    set Container($form) $parent.$form
    if {[info exists Description($form) ] && $USETOOLTIP} {
	tooltip::tooltip $parent.$form $Description($form)
    }
    #puts $form
}

proc packChild { group } {
    global Title Container Type Child
    if ![info exist Container($group)] {
	packField $group
    }
    set nrow 0
    # get children from Title or Child array 
    set children [getChildren Title $group]
    
    # If group has two or more possible selection of parameters.
    if {[info exists Type($group) ] && [string match $Type($group) Selection]}   {
    	set varname [join [split $group .] _]
	    upvar #0 $varname varValue
	    if [info exists varValue] {
	        set idx [lsearch $Title($group) $varValue]
	    } else {
	        set idx 0
    	}
    	set children [lindex $children $idx]
	    global Show
	    set Show($group) $children
    }
    
    # process children as pre-defined layout in Child(group) list 
    foreach row $children {
	set line ""
	foreach column $row {
	    #if column do not have a type attached, then just show its name 
	    if [info exists Type($group.$column)] {
		packChild $group.$column
		append line " $Container($group.$column) "
	    } elseif { [lsearch { - r } $column ] >= 0} {
		append line " $column "
	    }
	}
	if {[string length $line] >0 } {
	    #puts $line
	  #  eval "pack $line -padx 5 -pady 2 -fill both -side left"
	    eval "grid $line -padx 5 -pady 2 -sticky nw "
	    incr nrow
	}	
    }
   # grid columnconfig $Container($group) 0 -weight 1
   # grid rowconfig $Container($group) $nrow -weight 1

}

proc packField { field } { 
    global Type Container USETOOLTIP Description AttachedVariable Title
    #the default variable name attached to each input field is its access key with . replaced by _
    if ![info exists AttachedVariable($field)] {set varname [join [split $field .] _] }
    set parent [join [lrange [split $field .] 0 end-1] .] 
    set fieldname [lindex [split $field .] end]
    set Container($field) $Container($parent).$fieldname
    if [info exists Type($field)] {
       set type $Type($field)
     } else {
       set type Text
     }
     if ![winfo exists $Container($field)] {
         switch -glob $type {
           Group { 
                if {[string length $Title($field)] > 0} {
                     	ttk::labelframe $Container($field) -text $Title($field) -height 20
                    } else {
	                    ttk::frame $Container($field) -borderwidth 2 -relief raised
                    }
           }
           Selection {  ttk::labelframe $Container($field) }
           default {ttk::frame $Container($field) }
         }
     }
     switch -glob $type {
	 Group { packGroup $field }
	 File { packFile $field $varname }
	 Table(*) { packTable $field $varname}
	 Selection { packSelection $field $varname }
	 Entry { packEntry $field $varname }
	 Button { packButton $field $varname }
	 Label { packLabel $field}
	 Status(*) { packStatus $field $varname}
	 Status { packStatus $field $varname}
	 List {packList $field $varname}
	 default { packEntry $field $varname}
     }
     if {[info exists Description($field) ] && $USETOOLTIP} {
	    tooltip::tooltip $Container($field) $Description($field)
    }
}

proc packGroup { group } {
    global Title Description Container USETOOLTIP
    if {[info exists Description($group) ] && $USETOOLTIP} {
	tooltip::tooltip $Container($group) $Description($group)
    } 
} 

#pack different field types,each field will be corresponding to a variable to hold the input.
proc packFile { field varname } {
    global Type Description Title Container
    ttk::label $Container($field).name  -text $Title($field)
    ttk::entry $Container($field).entry -textvariable $varname  -width 30
    ttk::button $Container($field).open -text "Open" -command [list getFile $varname]
    pack $Container($field).name $Container($field).entry $Container($field).open -side left -padx 2 -anchor w
}

proc packEntry { field varname } {
    global Type Description Title Container
    upvar #0 $varname Var
    if [info exists Var] {
	set length [string length $Var]
    } else {
	set length 8
    }
    ttk::label $Container($field).name  -text $Title($field)
    ttk::entry $Container($field).entry -textvariable $varname  -width $length
    pack $Container($field).name $Container($field).entry  -side left -padx 2 -anchor w -fill both
}

proc packTable { field varname} {
    global Type Description Title Container
    upvar #0 $varname Table
    #set columns [regexp -inline Table\((.)*\) $Type($field) ]
    set columns [split [string range $Type($field) 6 end-1] ,]
    set size [getLength $Title($field)]
    set i 0
    ttk::frame $Container($field).title 
    set i 0
    foreach title $Title($field) {
	set column [lindex $columns $i]
	ttk::label $Container($field).title.$column -text $title -width [lindex $size $i]
	grid $Container($field).title.$column -row 0 -column $i -sticky n -padx 3
	incr i
    }
    pack $Container($field).title
    addTable $field $columns $varname
}

proc packSelection { group varname } {
    global Title Type Container 
    upvar #0 varname varValue
    set varValue [lindex $Title($group) 0]
    ttk::combobox $Container($group).selection -state readonly -values $Title($group) -textvariable $varname
    $Container($group) configure -labelwidget $Container($group).selection
    bind $Container($group).selection  <<ComboboxSelected>> [list showSelected $group $varname]

}
proc packButton { field varname } {
   global Title Type Container Description
   upvar #0 $varname Action
   if [info exists Title($field)] {
     set title $Title($field)
   } else {
     set title [lindex [split $field .] end]
   }
   set length [expr 6+[string length $title]]
   if ![info exists Action] {set Action ""} 
   ttk::button $Container($field).button -text $title -command $Action  -width $length
   pack $Container($field).button  -side left -padx 2 -anchor w -fill both
}
proc packLabel { field } {
    global Title Type Container Description
    if [info exists Title($field)] {
      set title $Title($field)
    } else {
      set title [lindex [split $field .] end]
    }
    set length [expr 6+[string length $title]]
    ttk::label $Container($field).label -text $Title($field)  
    pack $Container($field).label  -side left -padx 2 -anchor w 
}

set RefreshingList {}
proc packStatus {field varname} {
	global Title Type Container Description RefreshingList Format
	if [info exists Title($field)] {
	  set title $Title($field)
	} else {
	  set title ""
	}   
    if {[string match $Type($field) Status] == 0} { set type text }
	if ![regexp -- {Status\((.+)\)} $Type($field) matched type] { set type text }
	upvar #0 $varname Varname
	upvar #0 $Varname Var
	if ![info exists Var] {set value "Not Initialized." } else {set value $Var}
	switch -glob $type {
	   Progress* {
		   set max [lindex [split $type :] end]
		   set percentage [expr double($value)/double($max)]
		   if [catch  { set style [dict get $Format($field) style] }] { set style bar }
		   if [catch {set width [dict get $Format($field) width]}] {set width 100}
		   if [catch {set finishedcolor [dict get $Format($field) done}] { set finishedcolor green}
		   if [catch {set unfinishedcolor [dict get $Format($field) pending}] { set unfinishedcolor red }
		   if [catch {set title $Title($field)}] {set title ""}
		   switch $style {
		       bar {
		       ttk::progressbar $Container($field).bar -orient horizontal -length $width -mode determinate -maximum $max -variable $Varname
		       if { [string length $title] > 0} {
                 ttk::label $Container($field).title -text "$title :"
                 pack $Container($field).title $Container($field).bar  -side left -padx 2 -anchor w -fill both
		       } else {
		         pack $Container($field).bar  -side left -padx 2 -anchor w -fill both
		       }
		       }
		       dots {
		       if { [string length $title] > 0} { 
		            ttk::label $Container($field).title -text "$title :"
		            grid $Container($field).title -row 1 -column 1 -sticky n -padx 1
		            set newi 2
		       } else { set newi 1}
		       for {set i $newi} {$i <=$max } {incr i } {
			  if {$i <=$value} {set bg $finishedcolor } else { set bg $unfinishedcolor}
			  ttk::label $Container($field).dot$i -background $bg -width 1
			  grid $Container($field).dot$i -row 1 -column $i  -sticky n -padx 1		 
		       }
		       }
		   }
	   }
	   text {
	   	if {[string length $title] > 0}  {set text $title : $value } else { set text $value }
	   	set length [expr 6+[string length $text]]
	   	ttk::label $Container($field).label -text $text
	   	pack $Container($field).label  -side left -padx 2 -anchor w 
	   }
	   Error* {
	   if {[llength [lindex [split $type :]]] <2 } { 
	       set info "Error"
	   } else { 
	      set info [lrange [split $type :] 1 end ] 
	   }
	   ttk::label $Container($field).label -text $info
	   	pack $Container($field).label  -side left -padx 2 -anchor w 
	   }
	   default {
		set text $value
	   	set length [expr 6+[string length $text]]
		ttk::label $Container($field).label -text $text -width $length
		pack $Container($field).label  -side left -padx 2 -anchor w -fill both
	   }
	}
	lappend RefreshingList $field
    
}

proc packList { field varname } {
    global Container Type Selection Title Format
    #show title ?
    # foreach key 
    upvar #0 $varname Var
    if ![info exists Var] return 
    foreach {key def} $Var {
        ttk::frame $Container($field).$key -relief raised -takefocus 1 
        if [info exists Format($field.$key)] {
          set width 0
          if {![ catch {set width [dict get $Format($field.$key) width ] }] && $width > 0} {
             $Container($field).$key configure -width $width
          }
        }
        if ![info exists Selection($field.$key)] {
                $Container($field).$key configure  -relief raised  
            } elseif {!$Selection($field.$key)} {
               $Container($field).$key configure  -relief raised
        } else {
           $Container($field).$key configure  -relief flat 
        }
        set Container($field.$key)  $Container($field).$key
        ttk::label $Container($field).$key.id -text $key 
        set line "$Container($field).$key.id"
        foreach widget $def {
            packField $field.$key.$widget 
            append line " $Container($field.$key.$widget)"
        }
        eval "grid $line  -padx 1 -pady 2 -sticky nw"
        pack $Container($field).$key 
        #events for onhover or selection
        bind $Container($field).$key <Enter> [subst {
         %W configure -relief flat 
         # LightGrey
        }]
        bind $Container($field).$key <Leave> [subst {
            if !\[info exists Selection($field.$key)\] {
                %W configure  -relief raised  
            } elseif {!\$Selection($field.$key)} {
                %W configure  -relief raised
            }

        }]
        bindall $Container($field).$key "<1>" [subst {
          if !\[info exists Selection($field.$key)\] {
            set Selection($field.$key) 1
          } elseif { ! \$Selection($field.$key) } {
            set Selection($field.$key) 1
          } else {
            set Selection($field.$key) 0
          }
          puts "%W clicked"
        }]
        
    } 
}


# Utilities for packing

proc addTable { field columns varname } {
    global Type Description Title Container
    upvar #0 $varname Table
    set size [getLength $Title($field)]
    set nrow [llength $Table(rows) ]
    if { $nrow <= 1} { set state disabled 
    } else {
	set state normal
    }
    for {set row 0} { $row < $nrow } {incr row } {
        set i 0
	ttk::frame $Container($field).row$row
	pack $Container($field).row$row
	foreach column $columns {
	    if ![info exists Table($row,$column)] { set Table($row,$column) "" }
	    ttk::entry $Container($field).row$row.$column -width [lindex $size $i]  -textvariable "${varname}($row,$column)"
	    grid $Container($field).row$row.$column -row [expr 1+$row] -column $i  -sticky n -padx 1
	    incr i
	}
	ttk::button $Container($field).row$row.add -text + -command [list addRow $field $varname $row ] -width 1
	ttk::button $Container($field).row$row.remove -text - -width 1 -command [list removeRow $field $varname $row] -state $state
	grid $Container($field).row$row.add -row [expr 1+$row] -column $i
	grid $Container($field).row$row.remove -row [expr 1+$row] -column [expr $i+1]
    }

}

proc addRow { field varname row } {
    upvar #0 $varname Table 
    global Container Type
    set nrow [llength $Table(rows)]
    set columns [split [string range $Type($field) 6 end-1] ,]
    for { set i $nrow} { $i > [expr 1+$row] } { set i [expr $i -1]} {
	foreach col $columns {
	    set Table($i,$col) $Table([expr $i-1],$col)
	}
    }
    foreach col $columns {
	set Table([expr 1+$row],$col) ""
    }
    set Table(rows) [ linsert $Table(rows) $row $row]
    for {set i 0} {$i < $nrow } { incr i} {
	destroy $Container($field).row$i
    }
    addTable $field $columns $varname
}

proc removeRow { field varname row } {
    upvar #0 $varname Table 
    global Container Type
    set nrow [llength $Table(rows)]
    set columns [split [string range $Type($field) 6 end-1] ,]
    for { set i $row} { $i < [expr $nrow-1]} { incr i } {
	foreach col $columns {
	    set Table($i,$col) $Table([expr $i+1],$col)
	}
    }
    set Table(rows) [ lreplace $Table(rows) $row $row ]
    for {set i 0} {$i < $nrow } { incr i} {
	destroy $Container($field).row$i
    }
    addTable $field $columns $varname
}
proc getLength { title} {
    set names $title
    set i 0
    set length {}
    foreach name [lrange $names 1 end] {
	set j [string first $name $title ]
	if {$j > $i} { lappend length [expr $j -$i] }
	set i $j
    }
    lappend length [expr [string length $title]-$i]
    return $length
}

proc getFile { varname} {
    upvar #0 $varname varValue
    set dir [file dirname $varValue]
    set varValue [tk_getOpenFile -initialfile $varValue -initialdir $dir ]
    puts "set $varname $varValue"
}

proc showSelected { group varname} {
    global Title Child Container Show Type
    upvar #0 varname varValue
    set varValue [$Container($group).selection get]
    if [info exists varValue] {
	set idx [lsearch $Title($group) $varValue]
    } else {
	set idx 0
    }
    foreach row $Show($group) {
	foreach column $row {
	    if [info exists Container($group.$column)] {  
		destroy $Container($group.$column) 
		array unset Container $group.$column
	    }
	}
    }
    set Show($group) [lindex $Child($group) $idx]
    set nrow 0
    foreach row $Show($group) {
	set line ""
	foreach column $row {
	    if [info exists Type($group.$column)] {
		packChild $group.$column
		append line " $Container($group.$column) "
	    } else {
		append line " $column "
	    }
	}
	if {[string length $line] >0 } {
	  #  eval "pack $line -padx 5 -pady 2 -fill both -side left"
	    eval "grid $line -padx 5 -pady 2 -sticky nw "
	    incr nrow
	}	
    }

}

proc refreshStatus {} {
	global RefreshingList Container AttachedVariable
	foreach field $RefreshingList {
		destroy $Container($field)
		if ![info exists AttachedVariable($field)] {
			set varname [join [split $field .] _] 
		} else {
			set varname $AttachedVariable($field)
		}
		packStatus $field $varname
	}
}

 proc bindall { window args} {
   eval "bind $window $args"
   foreach child [winfo children $window] {
      eval "bind $child $args"
   }
 }

proc refreshField { field } {
    global Container 
    foreach child [array names Container $field.*] {
        destroy $Container($child)
    }
    packField $field 
}
